Mac Mania 2/MacMania 2.toast/Art⁄Graphics/Image 1.49/Macros/Measurement Macros

Text File | 1993-03-26 | 12.0 KB | 557 lines | [TEXT/ttxt]

macro 'Plot X-Y Coordinates';
{Plots the X-Y Coordinates of the current ROI. The plot will be
 upside down if "Invert Y Coordinates" is checked in Preferences.}
var
  i,w,h,width,height:integer;
  x,y,scale,xmax,ymax:real
begin
  RequiresVersion(1.48);
  if nCoordinates=0 then begin
    PutMessage('No XY-Coordinates currently available.');
    exit;
  end;
  SaveState;
  InvertY(false);
  xmax:=0;
  ymax:=0;
  for i:=1 to nCoordinates do begin
    x:=xCoordinates[i];
    y:=yCoordinates[i];
    if x>xmax then xmax:=x;
    if y>ymax then ymax:=y;
  end;
  scale:=sqrt((300*300)/(xmax*ymax));
  if (xmax*scale)>500 then scale:=500/xmax;
  if (ymax*scale)>500 then scale:=500/ymax;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(xmax*scale+20,ymax*scale+20);
  MakeNewWindow('Outline');
  MoveTo(xCoordinates[1]*scale+10,yCoordinates[1]*scale+10);
  for i:=2 to nCoordinates do
    LineTo(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10);
  SetFont('Helvetica');
  SetFontSize(12);
  SetText('No background, Center');
  GetPicSize(width,height);
  MoveTo(width/2,height/3);
  Writeln(nCoordinates:1,' coordinate pairs');
  RestoreState;
end;


macro 'Particle Analysis Test';
var
  x,y,rows,columns,maxradius,radius:integer;
begin
  SaveState;
  rows:=5; columns:=5;
  maxradius:=rows*columns;
  SetForegroundColor(255);
  SetBackgroundColor(0);
  SetNewSize(columns*maxradius*2+20,rows*maxradius*2+20);
  MakeNewWindow('Objects');
  radius:=1;
  for y:=0 to columns-1 do
    for x:=0 to rows-1 do begin
      MakeOvalRoi(x*maxradius*2+10,y*maxradius*2+10,radius*2,radius*2);
      Fill;
      radius:=radius+1;
    end;
  KillRoi;
  SetParticleSize(1,9999);
  LabelParticles(true);
  OutlineParticles(true);
  SetOptions('Area, Perimeter, Major, Minor');
  AnalyzeParticles;
  SetUser1Label('Perim.d');
  SetUser2Label('Area');
  for radius:=1 to maxradius do begin
    rUser1[radius]:=2*3.14159*radius;
    rUser2[radius]:=3.14159*sqr(radius);
  end;
  ShowResults;
  RestoreState;
end;


macro 'Count Particles at Random Locations';
var
  n,i,width,height,PicID,nLocations:integer;
  size:real;
begin
  RequiresVersion(1.44);
  nLocations:=10;
  size:=0.25;
  n:=1;
  GetPicSize(width,height);
  PicID:=PicNumber;
  SetUser1Label('Count');
  SetOptions('User1');
  for i:=1 to nLocations do begin
    SelectPic(PicID);
    MakeRoi((1-size)*width*random,(1-size)*height*random,size*width,size*height);
    Duplicate('Temp');;
    SetDensitySlice(255,255);
    AnalyzeParticles;
    Dispose;
    rUser1[i]:=rCount;
  end;
  KillRoi;
  SetCounter(nLocations);
  ShowResults;
end;


macro 'Make Circle from Line';
var
  x1,x2,y1,y2,top,left,width,height:integer;
  xcenter,ycenter,radius:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a line selection.');
    exit;
  end;
  xcenter:=x1+(x2-x1)/2;
  ycenter:=y1+(y2-y1)/2;
  radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  MakeOvalROI(xcenter-radius,ycenter-radius,radius*2,radius*2);
end;


macro 'Display Calibration Table';
{
Stores 0-255(all possible gray values) in the User1 column
and the 256 corresponding calibrated values in the User2 column.
Max Measurements must be set to 256 or greater. Use the Export
command to export the calibration table to a text file. The two
columns will be identical if the image is not calibrated.
}
var
  i:integer;
  v:real;
begin
  RequiresVersion(1.44);
  SetCounter(256);
  SetUser1Label('value');
  SetUser2Label('cvalue');
  for i:=0 to 255 do begin
    rUser1[i+1]:=i;
    rUser2[i+1]:=cvalue(i);
  end;
  ShowResults;
end;


macro 'Measure and draw line [L]';
var
  x1,x2,y1,y2,width:integer;
begin
  GetLine(x1,y1,x2,y2,width);
  if x1<0 then begin
    PutMessage('This macro requires a straight line selection.');
    exit;
  end;
  Measure;
  Fill;
  KillRoi;
end;


macro 'Measure All';
{Measures all currently open images using the current selection. There is}
{an implied "Select All" if the active image doesn't have a selection.}
var
  i,left,top,width,height:integer;
begin
  ResetCounter;
  for i:=1 to nPics do begin
    SelectPic(i);
    RestoreROI;
    Measure;
  end;
end;


macro 'Measure All from Disk';
{
Reads from disk and measures a set of images too large to simultaneously
fit in memory. The image names names must be in the form '01', '02', etc.
Before starting, open and outline the first image('01').
}
var
  i,width,height:integer;
begin
  GetPicSize(width,height);
  if width=0 then begin
    PutMessage('Before running this macro, open and outline the first image("01") in the series.');
    exit;
  end;
  ResetCounters;
  Measure;
  close;
  for i:=2 to 1000 do begin
    open(i:2);
    RestoreROI;
    Measure;
    close;
  end;
end;


macro 'Paste Results [P]'
{Use the Measure command, the ruler tool, or the pointing tool to}
{make up to about 10 measurements, then use this macro to paste}
{the results into the upper left corner of the window.}
begin
  SetFont('Monaco');
  SetFontSize(9);
  SetText('Plain; Align Left');
  SetOption; {Copy headings}
  CopyResults;
  MakeRoi(-10,0,250,150);
  Paste;
  KillRoi;
  ResetCounter;
end;


macro 'Measure Redirected and Label'
begin
  Redirect(true);
  Measure;
  Redirect(false);
  MarkSelection;
  RestoreRoi;
end;


macro 'Reset Measurement Options';
{Resets the Options dialog box in the Analyze menu to the default settings.}
begin
  RequiresVersion(1.44);
  SetOptions('Area; Mean');
  Redirect(false);
  LabelParticles(true);
  OutlineParticles(false);
  IgnoreParticlesTouchingEdge(false);
  IncludeInteriorHoles(false);
  WandAutoMeasure(false);
  AdjustAreas(false);
  SetParticleSize(1,999999);
  SetPrecision(2);
end;


macro 'Set Threshold';
var
  lower,upper:integer;
begin
  lower:=GetNumber('Lower:',1);
  upper:=GetNumber('Upper:',254);
  SetDensitySlice(lower,upper);
end;


macro 'Measure Accumulated Perimeter[A]';
{
Measures perimeter and computes accumulated perimeter,
storing it in the User1 column.
}
var
  i:integer;
  Total:real;
begin
  MeasurePerimeter(true);
  SetOptions('Area; Mean; Perimeter; User1');
  SetUser1Label('Total');
  Measure;
  Total:=0;
  for i:=1 to rCount do Total:=Total+rLength[i];
  rUser1[rCount]:=Total;
  UpdateResults;
end;


macro 'Count Black and White Pixels [B]';
{
Counts the number of black and white pixels in the current
selection and stores the counts in the User1 and User2 columns.
}
begin
  RequiresVersion(1.44);
  SetUser1Label('Black');
  SetUser2Label('White');
  Measure;
  rUser1[rCount]:=histogram[255];
  rUser2[rCount]:=histogram[0];
  UpdateResults;
end;


macro 'Compute Percent Black and White';
var
  nPixels,mean,mode,min,max:real;
begin
  RequiresVersion(1.44);
  SetUser1Label('Black');
  SetUser2Label('White');
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  rUser1[rCount]:=histogram[255]/nPixels;
  rUser2[rCount]:=histogram[0]/nPixels;
  UpdateResults;
end;


macro 'Compute Average and Total Area [T]';
{
Computes average and accumulated area and stores
the them in the Major and Minor Axis columns.
}
var
  i:integer;
  sum:real;
begin
  RequiresVersion(1.44);
  SetUser1Label('Avg');
  SetUser2Label('Total');
  SetOptions('Area; User1; User2');
  Measure;
  sum:=0;
  for i:=1 to rCount do sum:=sum+rArea[i];
  rUser1[rCount]:=sum/rCount;
  rUser2[rCount]:=sum;
  UpdateResults;
end;


macro 'Measure Circularity';
begin
  SetUser1Label('Shape');
  Measure;
  rUser1[rCount]:=4*3.14159265*(rArea[rCount]/sqr(rLength[rCount]));
  UpdateResults;
end;


macro 'Measure Mean * Area';
begin
  SetUser1Label('Mean*Area');
  Measure;
  rUser1[rCount]:=rMean[rCount]*rArea[rCount];
  UpdateResults;
end;


macro 'Fit  Ellipse and Draw in White';
var
  left,top,width,height:real;
begin
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SetOptions('Area; Mean; X-Y Center');
  Measure;
  SetOption; MarkSelection;
  KillRoi;
  SelectAll;
  KillRoi;
 end;


macro 'Draw XY Center';
var
  left,top,width,height,x,y:real;
begin
  RequiresVersion(1.44);
  GetRoi(left,top,width,height);
  if width=0 then begin
    PutMessage('This macro requires a selection.');
    exit;
  end;
  SaveState; {Invert Y status saved starting with V1.44b21}
  InvertY(false);
  SetForegroundColor(255); {black}
  SetOptions('Area; Mean; X-Y Center'); {XY Center}
  Measure;
  KillRoi;
  x:=rX[rCount];
  y:=rY[rCount];
  MoveTo(x-5,y);
  LineTo(x+5,y);
  MoveTo(x,y-5);
  LineTo(x,y+5);
  RestoreState;
end;


macro 'Plot Radial Density Profiles [R]';
var
  x1,y1,x2,y2,pi,angle,delta:real;
  LineWidth,i,nLines,radius,PlotWidth,PlotHeight:integer;
  MinPlotWidth,hMargin,vMargin,PlotLeft,PlotTop:integer;
  LeftMargin,RightMargin,TopMargin,BottomMargin:integer;
  ImageWindow,PlotWindow:integer;
  nPixels,mean,mode,min,max:real;
begin
  RequiresVersion(1.45);
  SaveState;
  GetLine(x1,y1,x2,y2,LineWidth)
  if x1<0 then begin
    PutMessage('Please select a point by clicking with the line tool.');
    exit;
  end;
  radius:=20;
  nLines:=8;
  MinPlotWidth:=140;
  pi:=3.14159;
  delta:=2.0*pi/nLines;
  angle:=0.0;
  PlotWidth:=radius;
  if PlotWidth<MinPlotWidth then PlotWidth:=MinPlotWidth;
  PlotHeight:=0.4*PlotWidth;
  SetPlotSize(PlotWidth,PlotHeight);
  MakeOvalRoi(x1-radius,y1-radius,radius*2,radius*2);
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  min:=min-10;
  if min<0 then min:=0;
  max:=max+10;
  if max>255 then max:=255;
  SetPlotScale(cValue(min),cValue(max));
  SetPlotLabels(false);
  hMargin:=5;
  vMargin:=5;
  if Calibrated
    then LeftMargin:=35
    else LeftMargin:=25;
  TopMargin:=10;
  RightMargin:=10;
  BottomMargin:=20;
  PlotLeft:=hMargin-LeftMargin;
  PlotTop:=vMargin-TopMargin;
  SetNewSize(PlotWidth+2*hMargin,PlotHeight*nLines);
  SetForegroundColor(255);
  SetBackgroundColor(0);
  ImageWindow:=PicNumber;
  MakeNewWindow('Plots');
  PlotWindow:=PicNumber;
  SelectPic(ImageWindow);
  for i:=1 TO nLines do begin
    x2:=x1+round(radius*cos(angle));
    y2:=y1+round(radius*sin(angle));
    MakeLineRoi(x1,y1,x2,y2);
    PlotProfile;
    Copy;
    SelectPic(PlotWindow);
    MakeRoi(PlotLeft,PlotTop,PlotWidth+LeftMargin+RightMargin,
          PlotHeight+TopMargin+BottomMargin);
    Paste;
    DoOr;
    PlotTop:=PlotTop+PlotHeight-1;
    SelectPic(ImageWindow);
    angle:=angle+delta;
  end;
  RestoreState;
end;


macro 'Circular Profile Plot [C]';
var
  radius,pi,angle,dx,dy,delta:real;
  x1,y1,x2,y2:real;
  npoints,i,value,LineWidth,x,y,px:integer;
begin
  GetLine(x1,y1,x2,y2,LineWidth)
  if x1<0 then begin
    PutMessage('Please select a point by clicking with the line tool.');
    exit;
  end;
  x:=x1+(x2-x1)/2;
  y:=y1+(y2-y1)/2;
  radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
  if radius<3 then begin
    PutMessage('The line selection must be longer than 5 pixels.');
    exit;
  end;
  npoints:=radius*2;
  pi:=3.14159;
  delta:=2.0*pi/npoints;
  angle:=0.0;
  px:=0;
  for i:=1 TO npoints do begin
    dx:=round(radius*cos(angle));
    dy:=round(radius*sin(angle));
    value:=GetPixel(x+dx,y+dy);
    PutPixel(x+dx,y+dy,255);
    PutPixel(px,0,value);
    px:=px+1;
    angle:=angle+delta;
  end;
  MakeLineRoi(0,0,npoints,0);
  PlotProfile;
  KillRoi;
end;


macro 'Compute Spatial Scale';
var
  scale:real;
begin
  MakeLineRoi(0,0,100,0);
  Measure;
  KillRoi;
  Scale:=100/rLength[rCount]);
  if scale=1
    then PutMessage('Image is not spatially calibrated')
    else PutMessage('Scale=',scale:1:4,' pixels/unit');
end;


macro 'Store Break in Results [S]';
{Stores a row of zeros in the results table.}
begin
  Measure;
  rArea[rCount]:=0;
  rMean[rCount]:=0;
  rStdDev[rCount]:=0;
  rX[rCount]:=0;
  rY[rCount]:=0;
  rLength[rCount]:=0;
  rMajor[rCount]:=0;
  rMinor[rCount]:=0;
  rAngle[rCount]:=0;
  UpdateResults;
end;


macro 'Measure both Raw and Calibrated';
{
This macro is a variation of the Measure command that displays the number
of pixels in User1 and uncalibrated(raw) mean density in User2. It takes
advantage of the fact that GetResults always returns uncalibrated values.
}
var
  nPixels,mean,mode,min,max:real;
begin
  SetUser1Label('Pixels');
  SetUser2Labe2('Raw Mean');
  Measure;
  GetResults(nPixels,mean,mode,min,max);
  rUser1[rCount]:=nPixels;
  rUser2[rCount]:=mean;
  UpdateResults;
end;